Pensieve header: Analysis of k=2 invariants in QU: Brute determination of the relations between the k=2 coefficients.

SetDirectory["C:\\drorbn\\AcademicPensieve\\Projects\\SL2Portfolio"];
<< KnotTheory`
<< "SL2PortfolioProgram.m"

OverbayP2Data=Get["C:\\drorbn\\AcademicPensieve\\People\\Overbay\\OverbayP2Data.m"];
OP2[K_Knot]:=K/.OverbayP2Data/.T->(T^(1/2));

{Length[OverbayP2Data],Last[OverbayP2Data]}

$p=5; $k=2; $U=QU;

SCθ[p_]:=Collect[ Cθ@(Subscript[𝕆, CU])[{y,a,x} ,p]/. {CU->Times, γ|ℏ->1}, ϵ, Simplify];
SQθ[p_]:=Collect[ Qθ@(Subscript[𝕆, QU])[{y,a,x} ,p]/. {QU->Times, γ|ℏ->1}, ϵ, Simplify];

(Subscript[𝔼[L_,Q_,P_], $k_]):=𝔼[L,Q,Series[Normal@P,{ϵ,0,$k}]];
(Subscript[(Subscript[𝔼, d_->r_])[L_,Q_,P_], $k_]):=(Subscript[𝔼, d->r])@@(Subscript[𝔼[L,Q,P], $k]);
𝔼3@𝔼[ω_,L_,Q_,Ps_]:=CF/@(Subscript[𝔼[L,(ω^(-1)) Q,(ω^(-1))((((ω^(-4))ϵ))^(-1+Range@Length@Ps)).Ps], $k]);
𝔼4@𝔼[L_,Q_,P_]:=Module[
{ω=((Normal[P])^(-1))/.ϵ->0,Ps=CoefficientList[P,ϵ]},
CF/@𝔼[ω,L,ω Q,(ω^(-3+4Range@Length@Ps))Ps]];
𝔼3@(Subscript[𝔼, sp___])[as___]:=𝔼3@𝔼[as]/.𝔼->(Subscript[𝔼, sp]);
𝔼4@(Subscript[𝔼, sp___])[as___]:=𝔼4@𝔼[as]/.𝔼->(Subscript[𝔼, sp]);

Clear[QP,ω];
QP[Knot[n_,k_]] := QP[Knot[n,k]]=Collect[Module[{fname},
fname="../SL2Invariant/k=2/Data/"<>ToString[n]<>"_"<>ToString[k]<>".m";
Collect[𝔼3[Get[fname][[2,2]]][[3]] // Normal, ϵ, Simplify]
], ϵ, CF];
ω[K_Knot]:=ω[K]=Factor[(((QP@K/.ϵ->0))^(-1))];
(Subscript[c, k_,d_])[K_Knot]:=Factor[SeriesCoefficient[QP[K],{y,0,0}, {ϵ,0,k},{a,0,d}]((ω[K])^(1+2k-d))]

H[p_]:=If[TrueQ@Simplify[p==(p/.T->1/T)],σ@@CoefficientList[Expand@Together[p]/.(T^(n_))/;n<0:>0,T], p];
H[p_]:=If[TrueQ@Simplify[p==(p/.T->1/T)],Style[Expand@Together[p]/.(T^(n_))/;n<0:>0, Background -> Yellow], p];
H[p_]:=If[TrueQ@Simplify[p==(p/.T->1/T)],Style[p, Background -> Yellow], p];

MatrixForm[Table[
H/@Factor/@{ω[K],(Subscript[c, 0,0])[K],(Subscript[c, 1,0])[K],(Subscript[c, 1,1])[K],(Subscript[c, 2,0])[K],(Subscript[c, 2,1])[K],(Subscript[c, 2,2])[K]OP2[K]},
{K,AllKnots[{3,7}]}
]]

p1[K_Knot]:=p1[K]=Factor[((T(-(Subscript[c, 1,0])[K]+ω[K]T(∂_T)ω[K]))/(((T-1))^2))];

MyCollect[ℰ_,vs_List]:=MyCollect[ℰ,vs,Identity];
MyCollect[ℰ_,vs_List,simp_]:=Total[CoefficientRules[ℰ,vs]/.((ps_->c_):>simp[c]Times@@((vs^ps)))]

Monitor[Total[Table[
Simplify[((Subscript[c, 0,0])[K]==1)∧(2T(∂_T)ω[K]== (Subscript[c, 1,1])[K])∧(0==(Subscript[c, 2,2])[K] (-3 (Subscript[c, 1,0])[K](∂_T)ω[K]+ω[K](∂_T)(Subscript[c, 1,0])[K])+(Subscript[c, 2,1])[K](-ω[K] (∂_T)ω[K]+2 T ((((∂_T)ω[K]))^2)-T ω[K] (∂_(T,T))ω[K]))∧((Subscript[c, 2,1])[K]==ω[K] (Subscript[c, 2,2])[K]+2 (((-1+T))^2) ω[K] (∂_T)p1[K]-((2 (-1+T) p1[K] (-(1+T) ω[K]+3 (-1+T) T (∂_T)ω[K]))/T))],
{K,AllKnots[{3,10}]}]],
K]

MatrixForm[Table[
H/@Factor/@{ω[K],p1[K],-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],(((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T)),(Subscript[c, 2,2])[K]/2,OP2[K]},
{K,AllKnots[{3,7}]}
]]

MatrixForm[mat=Table[
{q1=ω[K],q2=p1[K],(*((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),*)q3=-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],q4=ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T)),q5=((ω[K])^2)(Subscript[c, 2,2])[K]/2, q6=((ω[K])^2)p1[K]};
Times @@@Subsets[Together /@ {q1,q2,q3,q4,q5,q6}, 5] /. T->-1,
{K,AllKnots[{3,10}]}
]];
Dimensions[mat]
MatrixRank[mat]

MatrixForm[mat=Table[
{q1,q2,q3,q4,q5}=Together /@ {ω[K],p1[K],(*((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),*)-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T)),((ω[K])^2)(Subscript[c, 2,2])[K]/2};
Join@@Table[(q1^k){q2,q3,q4,q5},{k,0,10}] /. T->-1,
{K,AllKnots[{3,10}]}
]];
Dimensions[mat]
MatrixRank[mat]

Most/@(Join@@(Permutations/@(PadRight[#,6]& /@IntegerPartitions[3])))

MatrixForm[mat=Table[
vs=(Together /@ {ω[K],p1[K],((T(∂_T)p1[K])/(T-(T^(-1)))),((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T)),((ω[K])^2)(Subscript[c, 2,2])[K]/2(*,OP2[K]*)})/.T->(μ=(10^9));
PS=Select[Most/@(Join@@(Permutations/@(PadRight[#,1+Length[vs]]& /@IntegerPartitions[4]))), (Total[#[[-3;;-1]]]==1∧#[[3]]+#[[5]]≤1)&];
Table[Times@@(((v/@Range@Length@vs))^ps),{ps,PS}] /. v[i_]:>vs[[i]],
{K,AllKnots[{3,10}]}
]];
Dimensions[mat]
MatrixRank[mat]

NullSpace[mat].Table[Times@@(((v/@Range@Length@vs))^ps),{ps,PS}]

3(((μ-1))^2)==2999999994000000003

Monitor[Total[Table[
Simplify[((Subscript[c, 0,0])[K]==1)∧(2T(∂_T)ω[K]== (Subscript[c, 1,1])[K])∧( 0==-((((T+1))^2)/(3T/2))ω[K](((((T(∂_T)ω[K])/(T-(T^(-1))))))^2)(ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T)))+((T ((ω[K])^2)(T(∂_T)(T(∂_T)ω[K]))(ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T))))/(3(((T-1))^2)))-((T ω[K]p1[K](((ω[K])^2)(Subscript[c, 2,2])[K]/2))/(3(((T-1))^2)))-(1/3)ω[K](((T(∂_T)p1[K])/(T-(T^(-1)))))(((ω[K])^2)(Subscript[c, 2,2])[K]/2)+p1[K](((T(∂_T)ω[K])/(T-(T^(-1)))))(((ω[K])^2)(Subscript[c, 2,2])[K]/2))],
{K,AllKnots[{3,10}]}]],
K]

rel1=Simplify@ReleaseHold[Hold[-((((T+1))^2)/(3T/2))ω[K](((((T(∂_T)ω[K])/(T-(T^(-1))))))^2)(ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T)))+((T ((ω[K])^2)(T(∂_T)(T(∂_T)ω[K]))(ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T))))/(3(((T-1))^2)))-((T ω[K]p1[K](((ω[K])^2)(Subscript[c, 2,2])[K]/2))/(3(((T-1))^2)))-(1/3)ω[K](((T(∂_T)p1[K])/(T-(T^(-1)))))(((ω[K])^2)(Subscript[c, 2,2])[K]/2)+p1[K](((T(∂_T)ω[K])/(T-(T^(-1)))))(((ω[K])^2)(Subscript[c, 2,2])[K]/2)]/.K->T]

MyCollect[rel1,{ω[T],ω'[T],ω''[T],p1[T],p1'[T]},Simplify]

rel2=Simplify[rel1/.{p1[T]->((T(-(Subscript[c, 1,0])[T]+ω[T]T(∂_T)ω[T]))/(((T-1))^2)), p1'[T]->D[((T(-(Subscript[c, 1,0])[T]+ω[T]T(∂_T)ω[T]))/(((T-1))^2)),T]}]

MyCollect[6 ((((-1+T))^3)/((T^3)((ω[T])^2))) (1+T)rel2,{ω[T],ω'[T],ω''[T]},Simplify]

MyCollect[6 ((((-1+T))^3)/((T^3)((ω[T])^2))) (1+T)rel2,{ (Subscript[c, 2,1])[T], (Subscript[c, 2,2])[T]},Factor]

MatrixForm[mat=Table[
vs=(Together /@ {ω[K],p1[K],((T(∂_T)p1[K])/(T-(T^(-1)))),((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T)),((ω[K])^2)(Subscript[c, 2,2])[K]/2(*,OP2[K]*)})/.T->(μ=(10^9));
PS=Select[Most/@(Join@@(Permutations/@(PadRight[#,1+Length[vs]]& /@IntegerPartitions[5]))), (Total[#[[-3;;-1]]]==1∧#[[3]]+#[[5]]≤1)&];
Table[Times@@(((v/@Range@Length@vs))^ps),{ps,PS}] /. v[i_]:>vs[[i]],
{K,AllKnots[{3,10}]}
]];
Dimensions[mat]
MatrixRank[mat]

(ns5=NullSpace[mat].Table[Times@@(((v/@Range@Length@vs))^ps),{ps,PS}])//Column

Together[ns5/(-((1000000002000000001 v[1] ((v[4])^2) v[7])/1500000000)+((1000000000 ((v[1])^2) v[5] v[7])/2999999994000000003)-((1000000000 v[1] v[2] v[8])/2999999994000000003)-(1/3) v[1] v[3] v[8]+v[2] v[4] v[8])]

MatrixForm[mat=Table[
vs=(Together /@ {ω[K],p1[K],((T(∂_T)p1[K])/(T-(T^(-1)))),((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),T(∂_T)(T(∂_T)(T(∂_T)ω[K])),-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T))(*,((ω[K])^2)(Subscript[c, 2,2])[K]/2,OP2[K]*)})/.T->(μ=(10^4));
PS=Select[Most/@(Join@@(Permutations/@(PadRight[#,1+Length[vs]]& /@IntegerPartitions[5]))), (Total[#[[-2;;-1]]]==1∧#[[3]]+#[[5]]≤1∧#[[6]]≤1)&];
Table[Times@@(((v/@Range@Length@vs))^ps),{ps,PS}] /. v[i_]:>vs[[i]],
{K,AllKnots[{3,10}]}
]];
Dimensions[mat]
MatrixRank[mat]

MatrixForm[mat=Table[
vs=(Together /@ {ω[K],p1[K],((T(∂_T)p1[K])/(T-(T^(-1)))),((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),T(∂_T)(T(∂_T)(T(∂_T)ω[K])),-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T))(*,((ω[K])^2)(Subscript[c, 2,2])[K]/2,OP2[K]*)})/.T->(μ=(10^9));
PS=Select[Most/@(Join@@(Permutations/@(PadRight[#,1+Length[vs]]& /@IntegerPartitions[3]))), (Total[#[[-2;;-1]]]==1∧#[[3]]+#[[5]]≤2∧#[[6]]≤1)&];
Table[Times@@(((v/@Range@Length@vs))^ps),{ps,PS}] /. v[i_]:>vs[[i]],
{K,AllKnots[{3,10}]}
]];
Dimensions[mat]
MatrixRank[mat]

MatrixForm[mat=Table[
vs=(Together /@ {ω[K],p1[K],((T(∂_T)p1[K])/(T-(T^(-1)))),((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),T(∂_T)(T(∂_T)(T(∂_T)ω[K])),-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T))(*,((ω[K])^2)(Subscript[c, 2,2])[K]/2,OP2[K]*)})/.T->(μ=(10^9));
PS=Select[Most/@(Join@@(Permutations/@(PadRight[#,1+Length[vs]]& /@IntegerPartitions[3]))), (Total[#[[-2;;-1]]]≤1∧#[[3]]+#[[5]]≤2∧#[[6]]≤1)&];
Table[Times@@(((v/@Range@Length@vs))^ps),{ps,PS}] /. v[i_]:>vs[[i]],
{K,AllKnots[{3,10}]}
]];
Dimensions[mat]
MatrixRank[mat]

NullSpace[mat].Table[Times@@(((v/@Range@Length@vs))^ps),{ps,PS}]//Column

3 (999999998000000001/1000000000)(-((1000000000 ((v[1])^2) v[2])/2999999994000000003)-(1/3) ((v[1])^2) v[3]+v[1] v[2] v[4]-((1000000000 v[8])/2999999994000000003))//Expand

MyCollect[
(-((2((T^2)-1))/(T ω[T])))(-((v[1])^2) v[2]-(((((T-1))^2) ((v[1])^2) v[3])/T)+((3(((T-1))^2) v[1] v[2] v[4])/T)-v[8]) /. With[{K=T}, v[i_]:>{ω[K],p1[K],((T(∂_T)p1[K])/(T-(T^(-1)))),((T(∂_T)ω[K])/(T-(T^(-1)))),T(∂_T)(T(∂_T)ω[K]),T(∂_T)(T(∂_T)(T(∂_T)ω[K])),-2(Subscript[c, 2,0])[K]+ω[K](Subscript[c, 2,1])[K],ω[K](((Subscript[c, 2,1])[K]-ω[K](Subscript[c, 2,2])[K])/(-2T+2/T))(*,((ω[K])^2)(Subscript[c, 2,2])[K]/2,OP2[K]*)}[[i]]],
{(Subscript[c, 2,1])[T],(Subscript[c, 2,2])[T], p1[T],p1'[T]},Simplify]

Simplify[{(Subscript[c, 2,1])[T],(Subscript[c, 2,2])[T]}/.Solve[ReleaseHold[Hold[(0==(Subscript[c, 2,2])[K] (-3 (Subscript[c, 1,0])[K](∂_T)ω[K]+ω[K](∂_T)(Subscript[c, 1,0])[K])+(Subscript[c, 2,1])[K](-ω[K] (∂_T)ω[K]+2 T ((((∂_T)ω[K]))^2)-T ω[K] (∂_(T,T))ω[K]))∧((Subscript[c, 2,1])[K]==ω[K] (Subscript[c, 2,2])[K]+2 (((-1+T))^2) ω[K] (∂_T)p1[K]-((2 (-1+T) p1[K] (-(1+T) ω[K]+3 (-1+T) T (∂_T)ω[K]))/T))]/.(Subscript[c, 1,0])[K]->((-(((-1+T))^2) p1[T]+(T^2) ω[T] ω'[T])/T)/. K->T],
{(Subscript[c, 2,1])[T],(Subscript[c, 2,2])[T]}]]